home *** CD-ROM | disk | FTP | other *** search
/ HAKERIS 11 / HAKERIS 11.ISO / linux / system / LinuxConsole 0.4 / linuxconsole0.4install-en.iso / linuxconsole0.4.lcm / lib / perl5 / 5.8.0 / Pod / Text / Overstrike.pm < prev    next >
Encoding:
Perl POD Document  |  2004-03-26  |  6.5 KB  |  208 lines
  1. # Pod::Text::Overstrike -- Convert POD data to formatted overstrike text
  2. # $Id: Overstrike.pm,v 1.9 2002/07/15 05:46:00 eagle Exp $
  3. #
  4. # Created by Joe Smith <Joe.Smith@inwap.com> 30-Nov-2000
  5. #   (based on Pod::Text::Color by Russ Allbery <rra@stanford.edu>)
  6. #
  7. # This program is free software; you may redistribute it and/or modify it
  8. # under the same terms as Perl itself.
  9. #
  10. # This was written because the output from:
  11. #
  12. #     pod2text Text.pm > plain.txt; less plain.txt
  13. #
  14. # is not as rich as the output from
  15. #
  16. #     pod2man Text.pm | nroff -man > fancy.txt; less fancy.txt
  17. #
  18. # and because both Pod::Text::Color and Pod::Text::Termcap are not device
  19. # independent.
  20.  
  21. ##############################################################################
  22. # Modules and declarations
  23. ##############################################################################
  24.  
  25. package Pod::Text::Overstrike;
  26.  
  27. require 5.004;
  28.  
  29. use Pod::Text ();
  30.  
  31. use strict;
  32. use vars qw(@ISA $VERSION);
  33.  
  34. @ISA = qw(Pod::Text);
  35.  
  36. # Don't use the CVS revision as the version, since this module is also in Perl
  37. # core and too many things could munge CVS magic revision strings.  This
  38. # number should ideally be the same as the CVS revision in podlators, however.
  39. $VERSION = 1.09;
  40.  
  41.  
  42. ##############################################################################
  43. # Overrides
  44. ##############################################################################
  45.  
  46. # Make level one headings bold, overridding any existing formatting.
  47. sub cmd_head1 {
  48.     my ($self, $text, $line) = @_;
  49.     $text =~ s/\s+$//;
  50.     $text = $self->strip_format ($self->interpolate ($text, $line));
  51.     $text =~ s/(.)/$1\b$1/g;
  52.     $self->SUPER::cmd_head1 ($text);
  53. }
  54.  
  55. # Make level two headings bold, overriding any existing formatting.
  56. sub cmd_head2 {
  57.     my ($self, $text, $line) = @_;
  58.     $text =~ s/\s+$//;
  59.     $text = $self->strip_format ($self->interpolate ($text, $line));
  60.     $text =~ s/(.)/$1\b$1/g;
  61.     $self->SUPER::cmd_head2 ($text);
  62. }
  63.  
  64. # Make level three headings underscored, overriding any existing formatting.
  65. sub cmd_head3 {
  66.     my ($self, $text, $line) = @_;
  67.     $text =~ s/\s+$//;
  68.     $text = $self->strip_format ($self->interpolate ($text, $line));
  69.     $text =~ s/(.)/_\b$1/g;
  70.     $self->SUPER::cmd_head3 ($text);
  71. }
  72.  
  73. # Level four headings look like level three headings.
  74. sub cmd_head4 {
  75.     my ($self, $text, $line) = @_;
  76.     $text =~ s/\s+$//;
  77.     $text = $self->strip_format ($self->interpolate ($text, $line));
  78.     $text =~ s/(.)/_\b$1/g;
  79.     $self->SUPER::cmd_head4 ($text);
  80. }
  81.  
  82. # The common code for handling all headers.  We have to override to avoid
  83. # interpolating twice and because we don't want to honor alt.
  84. sub heading {
  85.     my ($self, $text, $line, $indent, $marker) = @_;
  86.     $self->item ("\n\n") if defined $$self{ITEM};
  87.     $text .= "\n" if $$self{loose};
  88.     $self->output (' ' x $indent . $text . "\n");
  89. }
  90.  
  91. # Fix the various formatting codes.
  92. sub seq_b { local $_ = strip_format (@_); s/(.)/$1\b$1/g; $_ }
  93. sub seq_f { local $_ = strip_format (@_); s/(.)/_\b$1/g; $_ }
  94. sub seq_i { local $_ = strip_format (@_); s/(.)/_\b$1/g; $_ }
  95.  
  96. # Output any included code in bold.
  97. sub output_code {
  98.     my ($self, $code) = @_;
  99.     $code =~ s/(.)/$1\b$1/g;
  100.     $self->output ($code);
  101. }
  102.  
  103. # We unfortunately have to override the wrapping code here, since the normal
  104. # wrapping code gets really confused by all the backspaces.
  105. sub wrap {
  106.     my $self = shift;
  107.     local $_ = shift;
  108.     my $output = '';
  109.     my $spaces = ' ' x $$self{MARGIN};
  110.     my $width = $$self{width} - $$self{MARGIN};
  111.     while (length > $width) {
  112.         # This regex represents a single character, that's possibly underlined
  113.         # or in bold (in which case, it's three characters; the character, a
  114.         # backspace, and a character).  Use [^\n] rather than . to protect
  115.         # against odd settings of $*.
  116.         my $char = '(?:[^\n][\b])?[^\n]';
  117.         if (s/^((?>$char){0,$width})(?:\Z|\s+)//) {
  118.             $output .= $spaces . $1 . "\n";
  119.         } else {
  120.             last;
  121.         }
  122.     }
  123.     $output .= $spaces . $_;
  124.     $output =~ s/\s+$/\n\n/;
  125.     $output;
  126. }
  127.  
  128. ##############################################################################
  129. # Utility functions
  130. ##############################################################################
  131.  
  132. # Strip all of the formatting from a provided string, returning the stripped
  133. # version.
  134. sub strip_format {
  135.     my ($self, $text) = @_;
  136.     $text =~ s/(.)[\b]\1/$1/g;
  137.     $text =~ s/_[\b]//g;
  138.     return $text;
  139. }
  140.  
  141. ##############################################################################
  142. # Module return value and documentation
  143. ##############################################################################
  144.  
  145. 1;
  146. __END__
  147.  
  148. =head1 NAME
  149.  
  150. Pod::Text::Overstrike - Convert POD data to formatted overstrike text
  151.  
  152. =head1 SYNOPSIS
  153.  
  154.     use Pod::Text::Overstrike;
  155.     my $parser = Pod::Text::Overstrike->new (sentence => 0, width => 78);
  156.  
  157.     # Read POD from STDIN and write to STDOUT.
  158.     $parser->parse_from_filehandle;
  159.  
  160.     # Read POD from file.pod and write to file.txt.
  161.     $parser->parse_from_file ('file.pod', 'file.txt');
  162.  
  163. =head1 DESCRIPTION
  164.  
  165. Pod::Text::Overstrike is a simple subclass of Pod::Text that highlights
  166. output text using overstrike sequences, in a manner similar to nroff.
  167. Characters in bold text are overstruck (character, backspace, character) and
  168. characters in underlined text are converted to overstruck underscores
  169. (underscore, backspace, character).  This format was originally designed for
  170. hardcopy terminals and/or lineprinters, yet is readable on softcopy (CRT)
  171. terminals.
  172.  
  173. Overstruck text is best viewed by page-at-a-time programs that take
  174. advantage of the terminal's B<stand-out> and I<underline> capabilities, such
  175. as the less program on Unix.
  176.  
  177. Apart from the overstrike, it in all ways functions like Pod::Text.  See
  178. L<Pod::Text> for details and available options.
  179.  
  180. =head1 BUGS
  181.  
  182. Currently, the outermost formatting instruction wins, so for example
  183. underlined text inside a region of bold text is displayed as simply bold.
  184. There may be some better approach possible.
  185.  
  186. =head1 SEE ALSO
  187.  
  188. L<Pod::Text>, L<Pod::Parser>
  189.  
  190. The current version of this module is always available from its web site at
  191. L<http://www.eyrie.org/~eagle/software/podlators/>.  It is also part of the
  192. Perl core distribution as of 5.6.0.
  193.  
  194. =head1 AUTHOR
  195.  
  196. Joe Smith <Joe.Smith@inwap.com>, using the framework created by Russ Allbery
  197. <rra@stanford.edu>.
  198.  
  199. =head1 COPYRIGHT AND LICENSE
  200.  
  201. Copyright 2000 by Joe Smith <Joe.Smith@inwap.com>.
  202. Copyright 2001 by Russ Allbery <rra@stanford.edu>.
  203.  
  204. This program is free software; you may redistribute it and/or modify it
  205. under the same terms as Perl itself.
  206.  
  207. =cut
  208.